home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / random / frmrand.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-02  |  7.8 KB  |  249 lines
  1. VERSION 2.00
  2. Begin Form Random 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Random Number Generator"
  5.    ClientHeight    =   4020
  6.    ClientLeft      =   1965
  7.    ClientTop       =   1620
  8.    ClientWidth     =   4590
  9.    Height          =   4425
  10.    Left            =   1905
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4020
  13.    ScaleWidth      =   4590
  14.    Top             =   1275
  15.    Width           =   4710
  16.    Begin TextBox txtValue 
  17.       Height          =   285
  18.       Left            =   2580
  19.       TabIndex        =   1
  20.       Top             =   660
  21.       Width           =   1095
  22.    End
  23.    Begin TextBox txtMin 
  24.       Height          =   285
  25.       Left            =   2580
  26.       TabIndex        =   2
  27.       Top             =   1860
  28.       Width           =   1095
  29.    End
  30.    Begin TextBox txtMax 
  31.       Height          =   285
  32.       Left            =   2580
  33.       TabIndex        =   3
  34.       Top             =   2460
  35.       Width           =   1095
  36.    End
  37.    Begin CommandButton cmdGenerate 
  38.       Caption         =   "&Generate"
  39.       Height          =   375
  40.       Left            =   1680
  41.       TabIndex        =   4
  42.       Top             =   3360
  43.       Width           =   1335
  44.    End
  45.    Begin Shape Shape1 
  46.       Height          =   2775
  47.       Left            =   480
  48.       Top             =   300
  49.       Width           =   3615
  50.    End
  51.    Begin Label Label1 
  52.       BackColor       =   &H00C0C0C0&
  53.       Caption         =   "Number of Values"
  54.       Height          =   375
  55.       Left            =   900
  56.       TabIndex        =   0
  57.       Top             =   660
  58.       Width           =   1335
  59.    End
  60.    Begin Label Label2 
  61.       BackColor       =   &H00C0C0C0&
  62.       Caption         =   "Minimum Value"
  63.       Height          =   375
  64.       Left            =   900
  65.       TabIndex        =   5
  66.       Top             =   1860
  67.       Width           =   1335
  68.    End
  69.    Begin Label Label3 
  70.       BackColor       =   &H00C0C0C0&
  71.       Caption         =   "Maximum Value"
  72.       Height          =   375
  73.       Left            =   900
  74.       TabIndex        =   6
  75.       Top             =   2460
  76.       Width           =   1335
  77.    End
  78. Option Explicit
  79.     Dim sMsg As String
  80. Sub cmdGenerate_Click ()
  81.     'Install error handler
  82.     On Error GoTo UnexpectedOops
  83.     'Test for valid range
  84.     If Val(TxtMax.Text) <= Val(TxtValue.Text) + Val(TxtMin.Text) Then
  85.         TxtMax.SetFocus
  86.         sMsg = "Range must be larger than the number of values generated."
  87.         MsgBox sMsg, 64, "Error"
  88.         sMsg = ""
  89.         Exit Sub
  90.     End If
  91.     ReDim numbers(1 To TxtValue.Text) As Integer
  92.     Dim I As Integer, n As Integer, temp As Integer
  93.     Randomize       ' seed random number generator
  94.     I = 1
  95.     Do
  96.                     ' generate random number between Min and Max
  97.         temp = Int(Rnd(1) * ((TxtMax.Text - TxtMin.Text) + 1) + TxtMin.Text)
  98.         If I = 1 Then  ' don't test if first number (will be = to itself)
  99.             numbers(I) = temp
  100.             I = I + 1
  101.         Else
  102.             For n = 1 To I - 1
  103.                 If numbers(n) = temp Then   ' check all numbers for duplicates
  104.                     Exit For
  105.                 End If
  106.             Next n
  107.             If numbers(n) <> temp Then      ' temp is unique
  108.                 numbers(I) = temp
  109.                 I = I + 1                   ' advance counter
  110.             Else
  111.                 ' do nothing, don't save temp to numbers() and
  112.                 ' don't advance I.
  113.                 ' go through loop again to search for a unique number
  114.             End If
  115.         End If
  116. Loop While I <= TxtValue.Text       ' repeat until you have enough unique numbers
  117.     ' Generate message box to display numbers
  118. For I = 1 To UBound(numbers)
  119.     sMsg = sMsg + Str$(numbers(I)) & ", "
  120. Next I
  121. MsgBox sMsg, 64, "Unique Random Numbers"
  122. sMsg = ""
  123. Exit Sub
  124. UnexpectedOops:
  125.     MsgBox Error$(Err)
  126.     Exit Sub
  127. End Sub
  128. Sub DrawFrame (TargetControl As Control, FrameWidth, FrameStyle)
  129. ' Function: Draw a 3D outline around a control.
  130. ' Syntax: DrawFrame Control, Width, Style
  131. ' Control = name of control the outline should
  132. '           be drawn around
  133. ' Width   = width of the outline
  134. ' Style   = Raised or Sunken look
  135. '           0 = Raised
  136. '           1 = Sunken
  137. ' Example: DrawFrame Text1, 2, 1
  138. ' gives a sunken 3D look to text1
  139.     Dim lft%, Rite%, Btm%, Tp%
  140.     Dim LftLine%, BtmLine%
  141.         'Determine style of outline
  142.     Select Case FrameStyle
  143.         Case 0                  'Raised
  144.             LftLine = 15
  145.             BtmLine = 0
  146.         Case 1                  'Sunken
  147.             LftLine = 0
  148.             BtmLine = 15
  149.     End Select
  150.         'Calculate coordinates of outline
  151.     lft = TargetControl.Left
  152.     Rite = TargetControl.Left + TargetControl.Width
  153.     Tp = TargetControl.Top
  154.     Btm = TargetControl.Top + TargetControl.Height
  155.     TargetControl.Parent.DrawWidth = FrameWidth
  156.         
  157.         'Draw Top line
  158.     TargetControl.Parent.Line (lft, Tp)-(Rite, Tp), QBColor(LftLine)
  159.         'Draw Left line
  160.     TargetControl.Parent.Line (lft, Tp)-(lft, Btm), QBColor(LftLine)
  161.         'Draw Bottom line
  162.     TargetControl.Parent.Line (lft, Btm)-(Rite, Btm), QBColor(BtmLine)
  163.         'Draw Right Line
  164.     TargetControl.Parent.Line (Rite, Tp)-(Rite, Btm), QBColor(BtmLine)
  165. End Sub
  166. Sub Form_Paint ()
  167.     DrawFrame TxtValue, 2, 1
  168.     DrawFrame TxtMin, 2, 1
  169.     DrawFrame TxtMax, 2, 1
  170. End Sub
  171. Sub Form_Unload (Cancel As Integer)
  172.     About.Show
  173. End Sub
  174. Sub txtMax_KeyPress (keyascii As Integer)
  175.     If keyascii < Asc("0") Or keyascii > Asc("9") Then
  176.         keyascii = 0            ' cancel the character
  177.         Beep                    ' sound error signal
  178.     End If
  179. End Sub
  180. Sub txtMax_LostFocus ()
  181.     If TxtMax.Text = "" Then
  182.         TxtMax.SetFocus
  183.         sMsg = "Please enter a Maximum value."
  184.         MsgBox sMsg, 64, "Error"
  185.         sMsg = ""
  186.         Exit Sub
  187.     End If
  188.     If Val(TxtMax.Text) <= Val(TxtMin.Text) Then
  189.         TxtMax.SetFocus
  190.         sMsg = "Maximum value must be greater than minimum value."
  191.         MsgBox sMsg, 64, "Error"
  192.         sMsg = ""
  193.         Exit Sub
  194.     End If
  195.     If Val(TxtMax.Text) <= Val(TxtValue.Text) + Val(TxtMin.Text) Then
  196.         TxtMax.SetFocus
  197.         sMsg = "Range must be larger than the number of values generated."
  198.         MsgBox sMsg, 64, "Error"
  199.         sMsg = ""
  200.         Exit Sub
  201.     End If
  202.     If Val(TxtMax.Text) >= 32767 Then
  203.         sMsg = "Number must be less than 32,767."
  204.         Beep
  205.         MsgBox sMsg, 64, "Error"
  206.         TxtMax.SetFocus
  207.         sMsg = ""
  208.         Exit Sub
  209.     End If
  210. End Sub
  211. Sub txtMin_KeyPress (keyascii As Integer)
  212.     If keyascii < Asc("0") Or keyascii > Asc("9") Then
  213.         keyascii = 0            ' cancel the character
  214.         Beep                    ' sound error signal
  215.     End If
  216. End Sub
  217. Sub txtMin_LostFocus ()
  218.     If TxtMin.Text = "" Then
  219.         TxtMin.SetFocus
  220.         sMsg = "Please enter a Minimum value."
  221.         MsgBox sMsg, 64, "Error"
  222.         sMsg = ""
  223.         Exit Sub
  224.     End If
  225.     If Val(TxtMin.Text) >= 32767 Then
  226.         sMsg = "Number must be less than 32,767."
  227.         Beep
  228.         MsgBox sMsg, 64, "Error"
  229.         TxtMin.SetFocus
  230.         sMsg = ""
  231.         Exit Sub
  232.     End If
  233. End Sub
  234. Sub txtValue_KeyPress (keyascii As Integer)
  235.     If keyascii < Asc("0") Or keyascii > Asc("9") Then
  236.         keyascii = 0            ' cancel the character
  237.         Beep                    ' sound error signal
  238.     End If
  239. End Sub
  240. Sub txtValue_LostFocus ()
  241.     If TxtValue.Text = "" Then
  242.         TxtValue.SetFocus
  243.         sMsg = "Please enter a number of values to generate."
  244.         MsgBox sMsg, 64, "Error"
  245.         sMsg = ""
  246.         Exit Sub
  247.     End If
  248. End Sub
  249.